home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Purity / Purity #22 (1994-01-19)(Diesel)(DE)[WB].zip / Purity #22 (1994-01-19)(Diesel)(DE)[WB].adf / Sierpinski / Sierpinski.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-17  |  8KB  |  218 lines
  1. {*******************************************************************}
  2. { SierPinski.PAS                                                         }
  3. {                                                                   }
  4. { Clear code for showing you the use of Intuition and Graphics on   }
  5. { the Amiga...                                                      }
  6. {*******************************************************************}
  7. { By Hans Luyten September 1993                                     }
  8. { Compiler: HighSpeed Pascal 1.1                                    }
  9. {*******************************************************************}
  10. PROGRAM SierPinski;
  11.  
  12. uses
  13.   Exec, Intuition, Graphics;          { We need these....           }
  14.  
  15. const
  16.     xTop = 250;
  17.     yTop = 10;
  18.     
  19. VAR
  20.   MyWindow  :  tNewWindow;            { Struct for the NewWindow    }
  21.   Window    : pWindow;                { Pointer to the NewWindow    }
  22.   MyRastPort:  pRastPort;             { Pointer to Window RastPort  }
  23.   
  24.   Teller    : INTEGER;
  25.   c         : CHAR;
  26.                   
  27.   TempString: ARRAY [1..80] OF byte;  { Temp C-stringkind           }
  28.   
  29.   Max_Been    : integer;
  30.   Min_Been  : integer;
  31.     
  32. {*******************************************************************}
  33. { OpenIntuitionLib(version);                                        }
  34. {                                                                   }
  35. { Tries to open the Intuition.library, if version=0 then ANY        }
  36. { version of intuition.library will be opened.                      }
  37. { It will return TRUE or FALSE.                                     }
  38. {*******************************************************************}  
  39. FUNCTION OpenIntuitionLib(version:INTEGER):BOOLEAN;
  40. BEGIN
  41.   IntuitionBase:=pIntuitionBase(OpenLibrary('intuition.library',version));
  42.   IF IntuitionBase=NIL THEN
  43.     OpenIntuitionLib:=FALSE
  44.   ELSE
  45.     OpenIntuitionLib:=TRUE;
  46. END;
  47.  
  48. {*******************************************************************}
  49. { OpenGraphicsLib(version);                                         }
  50. {                                                                   }
  51. { Tries to open the Graphics.library, if version=0 then ANY         }
  52. { version of Graphics.library will be opened.                       }
  53. { It will return TRUE or FALSE.                                     }
  54. {*******************************************************************}  
  55. FUNCTION OpenGraphicsLib(version:INTEGER):BOOLEAN;
  56. BEGIN
  57.   GfxBase:=pGfxBase(OpenLibrary('graphics.library',version));
  58.   IF GfxBase=NIL THEN
  59.     OpenGraphicsLib:=FALSE
  60.   ELSE
  61.     OpenGraphicsLib:=TRUE;
  62. END;
  63.  
  64. {*******************************************************************}
  65. { GfxText(RPort,x,y,color,'Text');                                  }
  66. {                                                                   }
  67. { Display the text on the rastport... using color and x,y           }
  68. { OutTextXY() look-a-like using intuition/graphics                  }
  69. {*******************************************************************}
  70. PROCEDURE GfxText(RPort : pRastPort; x,y : INTEGER; 
  71.                   color : INTEGER; TempText : String);
  72. VAR
  73.   TempString  :  ARRAY [1..80] OF byte;
  74. BEGIN
  75.   SetAPen(RPort,Color);                       { Set Pen Color       }
  76.   Move_(RPort,x,y);                           { Move pen            }
  77.   PasToC(TempText,TempString);                { Convert to C-String }
  78.   Text_(RPort,@TempString,length(TempText));  { Write string !!     }
  79. END;
  80.  
  81. {*******************************************************************}  
  82. { OpenNewWindow(....);                                              }
  83. {                                                                   }
  84. { Tries to open a NewWindow, ALL parameters for the NewWindowStruct }
  85. { are passed to OpenNewWindow !                                     }
  86. { It will return the pWindow pointer.                               }
  87. { TitleMode is TRUE if you USE a title, and FALSE if you don't !!   }
  88. {*******************************************************************}  
  89. FUNCTION OpenNewWindow(WLeftEdge,WTopEdge,WWidth,WHeight: INTEGER;
  90.                        WDetailPen,WBlockPen: shortint;
  91.                        WIDCMPFlags,WFlags: long;
  92.                        WFirstGadget: pGadget;
  93.                        WCheckMark: pImage;
  94.                        WTitle: string;
  95.                        WScreen: pScreen;
  96.                        WBitMap: pBitMap;
  97.                        WMinWidth,WMinHeight: INTEGER;
  98.                        WMaxWidth,WMaxHeight,WType_: word;
  99.                        TitleMode:BOOLEAN):pWindow;
  100. VAR TempWindow  :  tNewWindow;
  101.     TempTitle   :  ARRAY [1..80] OF byte;
  102. BEGIN
  103.   IF TitleMode THEN                { Title to C-format string       }
  104.     PasToC(WTitle,TempTitle);
  105.   WITH TempWindow DO
  106.     BEGIN
  107.       LeftEdge    :=WLeftEdge;
  108.       TopEdge     :=WTopEdge;
  109.       Width       :=WWidth;
  110.       Height      :=WHeight;
  111.       DetailPen   :=WDetailPen;
  112.       BlockPen    :=WBlockPen;
  113.       IDCMPFlags  :=WIDCMPFlags;
  114.       Flags       :=WFlags;
  115.       FirstGadget :=WFirstGadget;
  116.       CheckMark   :=WCheckMark;
  117.       Title       :=@TempTitle;    { POINTER to the title string    }
  118.       Screen      :=WScreen;
  119.       BitMap      :=WBitMap;
  120.       MinWidth    :=WMinwidth;
  121.       MinHeight   :=WMinHeight;
  122.       MaxWidth    :=WMaxWidth;
  123.       MaxHeight   :=WMaxHeight;
  124.       Type_       :=WType_;
  125.     END;
  126.     IF NOT(TitleMode) THEN
  127.       TempWindow.Title:=NIL;
  128.     OpenNewWindow := OpenWindow(@TempWindow);  
  129. END;
  130.  
  131. {*******************************************************************}  
  132. { DrieHoek(x,y,size);                                                                                                }
  133. {                                                                                                                                        }
  134. { This part draws a triangle with top (x,y) and leggs size.         }
  135. {*******************************************************************}  
  136. procedure Driehoek(x,y : integer; been : integer);
  137. var
  138.     x_Temp : integer;
  139.     y_Temp : integer;
  140. begin
  141.     Move_(MyRastPort,x,y);
  142.     
  143.     x_Temp:=x+(been div 2);
  144.     y_Temp:=y+round(sqrt(sqr(been)-sqr(been div 2)));
  145.     Draw(MyRastPort,x_Temp,y_Temp);
  146.     
  147.     x_Temp:=x-(been div 2);
  148.     Draw(MyRastPort,x_Temp,y_Temp);
  149.     
  150.     Draw(MyRastPort,x,y);
  151. end;
  152.  
  153. {*******************************************************************}  
  154. { Tri_Triangle(x,y,been,min_been);                                                                    }
  155. {                                                                                                                                     }
  156. { This is the recursive part of the Sierpinski routine.                            }
  157. {*******************************************************************}  
  158. procedure Tri_Triangle(x,y : integer; been, min_been: integer);
  159. var
  160.     x_Temp : integer;
  161.     y_Temp : integer;
  162. begin
  163.     if been >= Min_Been then
  164.         begin
  165.             been:=(been div 2);
  166.             DrieHoek(x,y,been);
  167.             Tri_Triangle(x,y,been,Min_Been);
  168.             
  169.             x_Temp:=x+(been div 2);
  170.             y_Temp:=y+round(sqrt(sqr(been)-sqr(been div 2)));
  171.             Driehoek(x_Temp,y_Temp,been);
  172.             Tri_Triangle(x_temp,y_temp,been, min_been);
  173.             
  174.             x_Temp:=x-(been div 2);
  175.             DrieHoek(x_Temp,y_Temp,been);
  176.             Tri_Triangle(x_temp,y_temp,been,min_been);
  177.         end;
  178. end;
  179.  
  180. {*******************************************************************}  
  181. { Main                                                              }
  182. {*******************************************************************}  
  183. BEGIN
  184.     Max_Been:=247;
  185.     Min_Been:=7;
  186.     
  187.   IF ((OpenIntuitionLib(39))AND(OpenGraphicsLib(39))) THEN
  188.   BEGIN
  189.     Window:=OpenNewWindow(10,10,600,240,2,3,ACTIVEWINDOW,
  190.                           SMART_REFRESH OR NOCAREREFRESH,
  191.                           NIL,NIL,
  192.                           'My First HighSpeed Pascal Window',
  193.                           NIL,NIL,10,10,640,256,
  194.                           WBENCHSCREEN,FALSE);
  195.             
  196.     IF Window<>NIL THEN
  197.       BEGIN  
  198.         MyRastPort:=Window^.RPort;            { The window-Rastport }
  199.         
  200.         GfxText(MyRastPort,370,20,4,'Sierpinski,...');
  201.         GfxText(MyRastPort,370,29,4,'A small HSPascal demo,');
  202.         GfxText(MyRastPort,370,38,4,'By Hans Luyten...');
  203.         
  204.         SetAPen(MyRastPort,1);
  205.         Tri_Triangle(xTop,yTop,max_been,min_been);
  206.         
  207.         GfxText(MyRastPort,370,50,3,'Waiting 3000 MilliSecs...');
  208.         
  209.         Delay(3000); 
  210.         
  211.         CloseWindow(Window);                  { Close the window    }
  212.       END
  213.     ELSE
  214.         writeln('Could not open a window !');
  215.     CloseLibrary(pLibrary(IntuitionBase));    { Close LIBS !!       }
  216.     CloseLibrary(pLibrary(GfxBase));
  217.   END;
  218. END.